home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / GCRELOC.ASM < prev    next >
Encoding:
Assembly Source File  |  1993-06-13  |  12.1 KB  |  452 lines
  1. ;* GCRELOC.ASM
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Borland TASM code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*        Relocate items to compact free space            *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: John Jensen        Date: 1985            *
  16. ;* Revision history:                            *
  17. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18. ;*                                    *
  19. ;*                    ``In nomine omnipotentii dei''    *
  20. ;************************************************************************
  21. IDEAL
  22. %PAGESIZE    60, 132
  23. MODEL    medium
  24. LOCALS    @@
  25.  
  26.     INCLUDE    "scheme.ash"
  27.  
  28. CODESEG
  29.  
  30. ;************************************************************************
  31. ;*          Garbage Collection -- Pointer Relocation Phase              *
  32. ;************************************************************************
  33. PROC C    srelocat USES si di
  34.     LOCAL    $$savedpage
  35.  
  36.     mov    bx, DEDPAGES*2        ; relocate all pages except first
  37. @@pageloop:
  38.     test    [attrib+bx], NOMEMORY
  39.     jnz    @@pagedone
  40.     mov    di, [word ptype+bx]
  41.     cmp    di, FREETYPE         ; Free Page?
  42.     je    @@pagedone
  43.     push    bx
  44.     call    rel_page        ; relocate pointers in current page
  45.     pop    bx
  46. @@pagedone:
  47.     add    bx, 2             ; increment page counter
  48.     cmp    bx, NUMPAGES*2         ; all pages processed?
  49.     jb    @@pageloop
  50.  
  51.     lea    di, [reg1]            ; relocate registers R1-R63
  52.     mov    cx, NUM_REGS-1
  53.     xor    bx, bx
  54. @@regloop:
  55.     call    rel_reg    C, di
  56.     add    di, size REG         ; increment pointer to next register
  57.     loop    @@regloop         ; loop until R1-R63 relocated
  58.     call    @REG@relocate$qv C    ; relocate other internal registers
  59.     mov    cx, HT_SIZE        ; relocate system oblist & property lists
  60.     xor    di, di
  61. @@tabloop:
  62.     mov    bl, [hash_page+di]     ; fetch hash table entry
  63.     shl    di, 1
  64.     mov    si, [hash_disp+di]
  65.     call    rel_ptr
  66.     mov    [hash_disp+di], si     ; store the relocated pointer
  67.     shr    di, 1
  68.     mov    [hash_page+di], bl
  69.     mov    bl, [prop_page+di]     ; fetch property list entry
  70.     shl    di, 1
  71.     mov    si, [prop_disp+di]
  72.     call    rel_ptr
  73.     mov    [prop_disp+di], si     ; store the relocated pointer
  74.     shr    di, 1
  75.     mov    [prop_page+di], bl
  76.     inc    di             ; increment the loop index
  77.     loop    @@tabloop
  78.  
  79.     lea    di, [s_stack]        ; Relocate in the runtime stack
  80.     mov    dx, [topofstack]
  81.     add    dx, di             ; compute stack's ending address
  82. @@stkloop:
  83.     mov    bl, [(POINTER di).page]; fetch next stack entry
  84.     mov    si, [(POINTER di).disp]
  85.     call    rel_ptr
  86.     mov    [(POINTER di).page], bl; store the relocated pointer
  87.     mov    [(POINTER di).disp], si
  88.     add    di, size POINTER     ; increment the stack buffer pointer
  89.     cmp    di, dx             ; top of stack ?
  90.     jbe    @@stkloop
  91.  
  92.     mov    bl, [obj_hlist.page]
  93.     mov    si, [obj_hlist.disp]
  94.     call    rel_ptr
  95.     mov    [obj_hlist.page], bl    ; store the relocated pointer
  96.     mov    [obj_hlist.disp], si
  97. @@return:
  98.     ret
  99. ENDP    srelocat
  100.  
  101. ;************************************************************************
  102. ;*         Local Support-- Relocate pointers in a single page           *
  103. ;************************************************************************
  104. PROC    rel_page    near
  105.     mov    [$$savedpage], bx
  106.     ldpage    es, bx
  107.     mov    dx, [psize+bx]
  108.     sub    dx, SIZE POINTER     ; adjust size of page boundary
  109.     mov    si, [word ptype+bx]
  110.     xor    di, di             ; zero the page index
  111.     xor    bx, bx
  112.     jmp    [@@table+si]
  113. DATASEG
  114. @@table    DW    @@list             ; [0] List cells
  115.     DW    @@fixnum         ; [1] Fixnums
  116.     DW    @@flonum         ; [2] Flonums
  117.     DW    @@bignum         ; [3] Bignums
  118.     DW    @@symbol         ; [4] Symbols
  119.     DW    @@string         ; [5] Strings
  120.     DW    @@array         ; [6] Arrays
  121.     DW    @@continuation         ; [7] Continuations
  122.     DW    @@closure         ; [8] Closures
  123.     DW    @@free             ; [9] Free space (unallocated)
  124.     DW    @@code             ; [10] Code
  125.     DW    @@inline        ; [11] Inline code
  126.     DW    @@port             ; [12] Port data objects
  127.     DW    @@char             ; [13] Characters
  128.     DW    @@environment         ; [14] Environments
  129. CODESEG
  130.  
  131. @@list:
  132.     sub    dx, size LISTDEF - size POINTER
  133. @@listloop:
  134.     mov    bl, [(FREELISTDEF es:di).tag]
  135.     cmp    bl, SPECFREE*2
  136.     je    @@listdone
  137.     test    [(LISTDEF es:di).gc], GC_BIT
  138.     jnz    @@listdone
  139. ;    mov    bl, [(LISTDEF es:di).car.page]    ; assuming the page is also here...
  140.     mov    si, [(LISTDEF es:di).car.disp]
  141.     call    rel_ptr         ; relocate the CAR
  142.     ldpage    es, [$$savedpage]
  143.     mov    [(LISTDEF es:di).car.page], bl
  144.     mov    [(LISTDEF es:di).car.disp], si
  145.     mov    bl, [(LISTDEF es:di).cdr.page]
  146.     mov    si, [(LISTDEF es:di).cdr.disp]
  147.     call    rel_ptr         ; relocate the CDR
  148.     ldpage    es, [$$savedpage]
  149.     mov    [(LISTDEF es:di).cdr.page], bl
  150.     mov    [(LISTDEF es:di).cdr.disp], si
  151. @@listdone:
  152.     add    di, SIZE LISTDEF    ; increment the page index
  153.     cmp    di, dx             ; end of page?
  154.     jbe    @@listloop
  155.     jmp    @@return
  156.  
  157. @@symbol:
  158. @@port:
  159. @@symloop:
  160.     cmp    [(SYMDEF es:di).tag], FREETYPE ; free block?
  161.     je    @@symdone
  162.     test    [(SYMDEF es:di).gc], GC_BIT
  163.     jnz    @@symdone
  164.     mov    bl, [(SYMDEF es:di).link.page]
  165.     mov    si, [(SYMDEF es:di).link.disp]
  166.     call    rel_ptr         ; relocate the link pointer
  167.     ldpage    es, [$$savedpage]
  168.     mov    [(SYMDEF es:di).link.page], bl
  169.     mov    [(SYMDEF es:di).link.disp], si
  170. @@symdone:
  171.     add    di, [(SYMDEF es:di).len] ; increment the page index
  172.     cmp    di, dx             ; end of page?
  173.     jbe    @@symloop
  174.     jmp    @@return
  175.  
  176. @@code:
  177. @@codeloop:
  178.     cmp    [(CODEDEF es:di).tag], FREETYPE ; is this a free block?
  179.     je    @@codedone
  180.     test    [(CODEDEF es:di).gc], GC_BIT
  181.     jnz    @@codedone
  182.     push    di             ; save starting offset of object
  183.     mov    cx, [(CODEDEF es:di).entry.val] ; get ending offset
  184.     add    cx, di
  185.     sub    cx, OFFSET (TYPE CODEDEF).consts
  186.     jmp    @@codetest
  187. @@codemore:
  188.     mov    bl, [(CODEDEF es:di).consts.page]
  189.     mov    si, [(CODEDEF es:di).consts.disp]
  190.     call    rel_ptr         ; relocate constant pointer
  191.     ldpage    es, [$$savedpage]
  192.     mov    [(CODEDEF es:di).consts.page], bl
  193.     mov    [(CODEDEF es:di).consts.disp], si
  194.     add    di, SIZE POINTER     ; increment the page index
  195. @@codetest:
  196.     cmp    di, cx             ; all pointers updated?
  197.     jb    @@codemore
  198.     pop    di             ; restore starting offset of object
  199. @@codedone:
  200.     add    di, [(CODEDEF es:di).len] ; adjust index for free area
  201.     cmp    di, dx             ; end of page?
  202.     jbe    @@codeloop
  203.     jmp    @@return
  204.  
  205. @@array:
  206. @@continuation:
  207. @@closure:
  208. @@environment:
  209. @@anyloop:
  210.     cmp    [(FREEDEF es:di).tag], FREETYPE ; free block?
  211.     je    @@anydone
  212.     test    [(ANYDEF es:di).gc], GC_BIT
  213.     jnz    @@anydone
  214.     mov    ax, di             ; save starting offset of object
  215.     mov    cx, [(ANYDEF es:di).len]; get ending offset
  216.     add    cx, di
  217.     sub    cx, OFFSET (TYPE STRDEF).buffer ; adjust ending offset for block header
  218.     jmp    @@anytest
  219. @@anymore:
  220.     mov    bl, [(ANYDEF es:di).data.page]
  221.     mov    si, [(ANYDEF es:di).data.disp]
  222.     call    rel_ptr         ; relocate vector item
  223.     ldpage    es, [$$savedpage]
  224.     mov    [(ANYDEF es:di).data.page], bl
  225.     mov    [(ANYDEF es:di).data.disp], si
  226.     add    di, SIZE POINTER     ; increment the page index
  227. @@anytest:
  228.     cmp    di, cx             ; all pointers updated?
  229.     jb    @@anymore
  230.     mov    di, ax             ; restore starting offset of object
  231. @@anydone:
  232.     add    di, [(ANYDEF es:di).len]
  233.     cmp    di, dx             ; end of page?
  234.     jbe    @@anyloop
  235.     jmp    @@return
  236.  
  237. @@fixnum:
  238. @@flonum:
  239. @@bignum:
  240. @@string:
  241. @@inline:
  242. @@free:
  243. @@char:
  244. @@return:
  245.     ret
  246. ENDP    rel_page
  247.  
  248. ;************************************************************************
  249. ;*      Local Support-- Relocate a pointer contained in a register      *
  250. ;*                                                                      *
  251. ;* Parameters:  address of register                    *
  252. ;************************************************************************
  253. PROC C    rel_reg    USES si di, @@reg
  254.     xor    bx, bx
  255.     mov    di, [@@reg]
  256.     mov    bl, [(REG di).bpage]
  257.     mov    si, [(REG di).disp]
  258.     call    rel_ptr
  259.     mov    [(REG di).bpage], bl
  260.     mov    [(REG di).disp], si
  261.     ret
  262. ENDP    rel_reg
  263.  
  264. ;************************************************************************
  265. ;*            Local Support-- Relocate a single pointer                 *
  266. ;*                                                                      *
  267. ;* Parameters:  bx - page number index (page*2)                         *
  268. ;*              si - displacement                                       *
  269. ;************************************************************************
  270. PROC    rel_ptr    near
  271.     cmp    bx, DEDPAGES*2         ; is this a special non-GCed page?
  272.     jl    @@return
  273.     push    es di
  274.     ldpage    es, bx         ; load the paragraph address for ptr's page
  275.     mov    di, [WORD ptype+bx]
  276.     cmp    di, NUMTYPES*2
  277.     jae    @@invalid
  278.     jmp    [@@table+di]
  279. DATASEG
  280. @@table    DW    @@list             ; [0] List cells
  281.     DW    @@fixnum         ; [1] Fixnums
  282.     DW    @@flonum         ; [2] Flonums
  283.     DW    @@bignum         ; [3] Bignums
  284.     DW    @@symbol         ; [4] Symbols
  285.     DW    @@string         ; [5] Strings
  286.     DW    @@array         ; [6] Arrays
  287.     DW    @@continuation         ; [7] Continuations
  288.     DW    @@closure         ; [8] Closures
  289.     DW    @@free             ; [9] Free space (unallocated)
  290.     DW    @@code             ; [10] Code
  291.     DW    @@inline        ; [11] Inline code
  292.     DW    @@port             ; [12] Port data objects
  293.     DW    @@char             ; [13] Characters
  294.     DW    @@environment         ; [14] Environments
  295. CODESEG
  296.  
  297. @@invalid:
  298.     push    ax cx dx
  299.     lea    ax, [@@msg]
  300. DATASEG
  301. @@msg    DB    "[VM INTERNAL ERROR] rel_ptr: invalid %x:%04x (unadjusted)", LF, 0
  302. CODESEG
  303.     call    zprintf C, ax, bx, si    ; print the error message (page:disp)
  304.     call    force_debug         ; invoke the VM debugger with next instr.
  305.     pop    dx cx ax
  306.     jmp    @@exit
  307.  
  308. @@list:
  309.     test    [(LISTDEF es:si).gc], GC_BIT
  310.     jz    @@exit
  311.     mov    bl, [(LISTDEF es:si).ptr.page]
  312.     mov    si, [(LISTDEF es:si).ptr.disp]
  313.     and    bl, NOT GC_BIT
  314.     jmp    @@exit
  315.  
  316. @@flonum:
  317.     test    [(FLODEF es:si).gc], GC_BIT
  318.     jz    @@exit
  319.     mov    bl, [(FLODEF es:si).ptr.page]
  320.     mov    si, [(FLODEF es:si).ptr.disp]
  321.     jmp    @@exit
  322.  
  323. @@bignum:
  324. @@symbol:
  325. @@string:
  326. @@inline:
  327. @@array:
  328. @@continuation:
  329. @@closure:
  330. @@code:
  331. @@port:
  332. @@environment:
  333.     test    [(ANYDEF es:si).gc], GC_BIT
  334.     jz    @@exit
  335.     mov    bl, [(ANYDEF es:si).data.page]
  336.     mov    si, [(ANYDEF es:si).data.disp]
  337. ;    jmp    @@exit            ; fall thru
  338.  
  339. @@fixnum:
  340. @@free:
  341. @@char:
  342. @@exit:
  343.     pop    di es
  344. @@return:
  345.     ret
  346. ENDP    rel_ptr
  347.  
  348. ;************************************************************************
  349. ;*                      Complement GC (forwarding) Bits                 *
  350. ;************************************************************************
  351. PROC C    togglegc USES si di
  352.     mov    bx, DEDPAGES*2         ; initialize page counter
  353. @@loop:
  354.     test    [attrib+bx], NOMEMORY
  355.     jnz    @@done
  356.     mov    di, [WORD ss:ptype+bx]    ; get data type for page
  357.     cmp    di, FREETYPE
  358.     je    @@done
  359.     push    bx
  360.     call    dopage             ; complement GC bits in current page
  361.     pop    bx
  362. @@done:
  363.     add    bx, 2
  364.     cmp    bx, NUMPAGES*2     ; all pages processed?
  365.     jb    @@loop
  366.     ret
  367.  
  368. PROC    dopage    near
  369.     ldpage    es, bx
  370.     mov    dx, [psize+bx]
  371.     sub    dx, SIZE POINTER     ; adjust for end of page boundary
  372.     mov    si, [WORD ptype+bx]
  373.     xor    di, di             ; clear the page index
  374.     xor    bx, bx
  375.     jmp    [@@table+si]
  376. DATASEG
  377. @@table    DW    @@list             ; [0] List cells
  378.     DW    @@fixnum         ; [1] fixnums
  379.     DW    @@flonum         ; [2] flonums
  380.     DW    @@bignum         ; [3] bignums
  381.     DW    @@symbol         ; [4] symbols
  382.     DW    @@string         ; [5] strings
  383.     DW    @@array         ; [6] Arrays
  384.     DW    @@continuation         ; [7] continuations
  385.     DW    @@closure         ; [8] closures
  386.     DW    @@free             ; [9] Free space (unallocated)
  387.     DW    @@code             ; [10] Code
  388.     DW    @@inline        ; [11] Inline code
  389.     DW    @@port             ; [12] Port data objects
  390.     DW    @@char             ; [13] Characters
  391.     DW    @@environment         ; [14] environmentironments
  392. CODESEG
  393.  
  394. @@list:
  395.     sub    dx, SIZE LISTDEF - SIZE POINTER
  396. @@listloop:
  397.     cmp    [(FREELISTDEF es:di).tag], SPECFREE*2
  398.     je    @@listskip
  399.     xor    [(LISTDEF es:di).gc], GC_BIT
  400. @@listskip:
  401.     add    di, SIZE LISTDEF    ; increment the page index
  402.     cmp    di, dx             ; end of page?
  403.     jbe    @@listloop
  404.     jmp    @@return
  405.  
  406. @@flonum:
  407.     sub    dx, SIZE FLODEF - SIZE POINTER
  408. @@flonumloop:
  409.     cmp    [(FREEFLODEF es:di).tag], FREETYPE
  410.     je    @@flonumskip
  411.     xor    [(FLODEF es:di).gc], GC_BIT
  412. @@flonumskip:
  413.     add    di, SIZE FLODEF        ; increment the page index
  414.     cmp    di, dx             ; end of page?
  415.     jbe    @@flonumloop
  416.     jmp    @@return
  417.  
  418. @@string:
  419. @@inline:
  420. @@bignum:
  421. @@symbol:
  422. @@array:
  423. @@continuation:
  424. @@closure:
  425. @@code:
  426. @@port:
  427. @@environment:
  428. @@anyloop:
  429.     cmp    [(FREEDEF es:di).tag], FREETYPE
  430.     je    @@anyskip
  431.     xor    [(ANYDEF es:di).gc], GC_BIT
  432. @@anyskip:
  433.     mov    cx, [(ANYDEF es:di).len] ; adjust index for free area
  434.     or    cx, cx            ; check for small stringing
  435.     jge    @@bigstring
  436.     mov    cx, OFFSET (TYPE STRDEF).buffer + SIZE POINTER
  437. @@bigstring:
  438.     add    di, cx
  439.     cmp    di, dx             ; end of page?
  440.     jbe    @@anyloop
  441.     jmp    @@return
  442. @@fixnum:
  443. @@free:
  444. @@char:
  445. @@return:
  446.     ret
  447. ENDP    dopage
  448.  
  449. ENDP    togglegc
  450.  
  451.     END
  452.